home *** CD-ROM | disk | FTP | other *** search
/ Aminet 39 / Aminet 39 (2000)(Schatztruhe)[!][Oct 2000].iso / Aminet / util / wb / SNDMon2.lha / SNDMon / Source / SNDMon2.asc next >
Encoding:
Text File  |  2000-07-12  |  5.3 KB  |  200 lines
  1. ;' Based On DMA Monitor - SNG March 1999, HiSoft BASIC, WB2+
  2. .initalize
  3.   WBStartup:NoCli:CloseEd
  4.   WbToScreen 0
  5.   WBenchToFront_
  6.  
  7.   *scr.Screen=Peek.l(Addr Screen(0)) ; get some screen info
  8.   scrnh.w = *scr\Height
  9.   scrnw.w = *scr\Width
  10.   ;scrnd.w = *scr\Depth
  11.   ;scrnd=1^scrnd
  12.  
  13.   as.s="C:Audioselect"
  14.   name.s=Peek$(Peek.l(FindTask_(0)+$B0)+4)
  15.   title.s=name+" V0.02"
  16.   oldstat.s="0"
  17.  
  18.   If Exists(as)
  19.     picasso.b=True
  20.   Else
  21.     picasso=False
  22.   EndIf
  23.  
  24.   JSR loadprefs
  25.   JSR creategfx
  26.  
  27.   If picasso
  28.     ShapeGadget 0,2,2,$0,0,0,1
  29.     ShapeGadget 0,19,2,$0,1,0,1
  30.     ShapeGadget 0,36,2,$0,2,0,1
  31.     ShapeGadget 0,53,2,$0,3,0,1
  32.  
  33.     Dim cmd.s(3)
  34.     cmd(0)=as+" source=amiga set"
  35.     cmd(1)=as+" source=av set"
  36.     cmd(2)=as+" source=cd set"
  37.     cmd(3)=as+" source=linein set"
  38.     Window 0,xpos.w,ypos.w,72,10,$800,"",1,2,0
  39.   Else
  40.     Window 0,xpos,ypos,72,10,$800,"",1,2
  41.   EndIf
  42.   rp.l=RastPort(0)
  43.  
  44.   ;###[ CREATE OUR CUSTOM DRAGBAR! ]################################
  45.  
  46.   ;--- As David said, this looks bloody horrible, but it works :)
  47.   ;
  48.   DEFTYPE.Gadget      *gad
  49.   DEFTYPE.NewGadget   ng
  50.  
  51.   ;--- some stuff we need :)
  52.   ;
  53.   *WinAddr = Peek.l(Addr Window(0))
  54.   *VisInfo = GetVisualInfoA_(*scr,0)
  55.   *gad = CreateContext_(&*GadList)
  56.  
  57.   ;--- Create drag bar gadget stuff
  58.   ;
  59.   ng\ng_LeftEdge  = 0
  60.   ng\ng_TopEdge   = 0
  61.   ng\ng_Width     = 72
  62.   ng\ng_Height    = 10
  63.   ng\ng_GadgetText= 0
  64.   ng\ng_TextAttr  = 0
  65.   ng\ng_GadgetID  = -1
  66.  
  67.   ng\ng_Flags     = 0
  68.   ng\ng_VisualInfo= *VisInfo
  69.   ng\ng_UserData  = 0
  70.   *gad = CreateGadgetA_(#GENERIC_KIND, *gad, &ng, 0)
  71.  
  72.   *gad\Activation = *gad\Activation | #GACT_IMMEDIATE | #GACT_RELVERIFY
  73.   *gad\GadgetType = #GTYP_WDRAGGING | #GTYP_BOOLGADGET
  74.   *gad\Flags = *gad\Flags | #GFLG_GADGHNONE
  75.  
  76.   ;--- Add our custom dragbar to the window...
  77.   ;
  78.   AddGList_ *WinAddr,*GadList,-1,-1,0
  79.   RefreshGList_ *GadList,*WinAddr,0,-1
  80.   GT_RefreshWindow_ *WinAddr,0
  81.  
  82.   ;###[ END CREATE OUR CUSTOM DRAGBAR! ]############################
  83.   SetAPen_ rp,light.w   ;draw border round window
  84.   Move_ rp,0,9
  85.   Draw_ rp,0,0
  86.   Draw_ rp,71,0
  87.   SetAPen_ rp,dark.w
  88.   Draw_ rp,71,9
  89.   Draw_ rp,1,9
  90.   SetAPen_ rp,back.w
  91.   RectFill_ rp,1,1,70,8
  92.  
  93.   Repeat
  94.     stat.s=Right$(Bin$(Peek.w($dff002)),4) ; get DMA information
  95.     If stat<>oldstat                       ; check for change
  96.       chnl.b=4
  97.       For a.b=0 To 3
  98.         If Mid$(stat,chnl,1)="1"           ; get channel status
  99.           If lon.w=0 Then RectFill_ rp,17*a+2,3,17*a+18,6
  100.           WBlit 1,17*a+2,2                 ; if on activate led
  101.         Else
  102.           If loff.w=0 Then RectFill_ rp,17*a+2,3,17*a+18,6
  103.           WBlit 0,17*a+2,2                 ; and draw off led
  104.         EndIf
  105.         chnl-1
  106.       Next
  107.       oldstat.s=stat
  108.     EndIf
  109.     For j=1 To 10                          ; pause about 1/5th second
  110.       WaitTOF_
  111.     Next
  112.     If picasso
  113.       If Event=$40
  114.         Execute_ &cmd(GadgetHit),0,0
  115.         oldstat="0"
  116.       EndIf
  117.     EndIf
  118.     k.s=Inkey$
  119.   Until k=Chr$(27)                         ; quit if esc pressed
  120.  
  121.   JSR saveprefs
  122.  
  123.   RemoveGList_ *WinAddr,*GadList,-1        ; clean up and bye bye...
  124.   FreeGadgets_ *GadList
  125.   FreeVisualInfo_ *VisInfo
  126.   Free Window 0
  127. End
  128.  
  129. .loadprefs
  130.   If GetIconObject("PROGDIR:"+name)
  131.     border.w =Val(FindToolValue("BORDER"))
  132.     loff.w   =Val(FindToolValue("LIGHTOFF"))
  133.     lon.w    =Val(FindToolValue("LIGHTON"))
  134.     hoff.w   =Val(FindToolValue("HILIGHTOFF"))
  135.     hon.w    =Val(FindToolValue("HILIGHTON"))
  136.     back.w   =Val(FindToolValue("BACKGROUND"))
  137.     light.w  =Val(FindToolValue("LIGHT"))
  138.     dark.w   =Val(FindToolValue("DARK"))
  139.     xpos.w   =Val(FindToolValue("XPOS"))
  140.     ypos.w   =Val(FindToolValue("YPOS"))
  141.     FreeIconObject
  142.  
  143.     If border > 255 Then border=1
  144.     If loff   > 255 Then loff=0
  145.     If lon    > 255 Then lon=3
  146.     If hoff   > 255 Then hoff=2
  147.     If hon    > 255 Then hon=2
  148.     If back   > 255 Then back=0
  149.     If light  > 255 Then light=2
  150.     If dark   > 255 Then dark=1
  151.     If xpos>scrnw-72 Then xpos=scrnw-72
  152.     If ypos>scrnh-10 Then ypos=scrnh-10
  153.  
  154.   Else
  155.     Request "Error...","Can't Open Tooltypes","_Ok"
  156.     End
  157.   EndIf
  158. RTS
  159.  
  160. .saveprefs
  161.   If GetIconObject("PROGDIR:"+name)
  162.     ok=SetToolValue ("BORDER",Str$(border))
  163.     If ok=False Then NewToolType "BORDER",Str$(border)
  164.     ok=SetToolValue ("LIGHTOFF",Str$(loff))
  165.     If ok=False Then NewToolType "LIGHTOFF",Str$(loff)
  166.     ok=SetToolValue ("LIGHTON",Str$(lon))
  167.     If ok=False Then NewToolType "LIGHTON",Str$(lon)
  168.     ok=SetToolValue ("HILIGHTOFF",Str$(hoff))
  169.     If ok=False Then NewToolType "HILIGHTOFF",Str$(hoff)
  170.     ok=SetToolValue ("HILIGHTON",Str$(hon))
  171.     If ok=False Then NewToolType "HILIGHTON",Str$(hon)
  172.     ok=SetToolValue ("BACKGROUND",Str$(back))
  173.     If ok=False Then NewToolType "BACKGROUND",Str$(back)
  174.     ok=SetToolValue ("LIGHT",Str$(light))
  175.     If ok=False Then NewToolType "LIGHT",Str$(light)
  176.     ok=SetToolValue ("DARK",Str$(dark))
  177.     If ok=False Then NewToolType "DARK",Str$(dark)
  178.     ok=SetToolValue ("XPOS",Str$(xpos))
  179.     If ok=False Then NewToolType "YPOS",Str$(ypos)
  180.     ok=SetToolValue ("XPOS",Str$(xpos))
  181.     If ok=False Then NewToolType "YPOS",Str$(ypos)
  182.     FreeIconObject
  183.   Else
  184.     Request "Error...","Cannot Save Prefs","Oh Sh*t..."
  185.   EndIf
  186. RTS
  187.  
  188. .creategfx
  189.   BitMap 0,16,6,8    ;create led shapes
  190.     Boxf 0,0,15,5,border
  191.     Boxf 1,1,14,4,loff
  192.     Boxf 1,1,2,2,hoff
  193.     GetaShape 0,0,0,16,6
  194.     Boxf 1,1,14,4,lon
  195.     Boxf 1,1,2,2,hon
  196.     GetaShape 1,0,0,16,6
  197.   Free BitMap 0
  198. RTS
  199.  
  200.